home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / remote / ratotp.zip / RATOTP.PAS < prev    next >
Pascal/Delphi Source File  |  1990-07-14  |  4KB  |  146 lines
  1. {$M 8192,0,0}
  2.  
  3. {  RATOTP - Convert PAGE.RA to TP source version 1.0    }
  4. {  Copyright (C) 1990 RodentWare, all rights reserved.  }
  5. {  Michael Reece/James Calvert * 1:3801/42  }
  6.  
  7. Program ROTOTP;
  8.  
  9. Uses
  10.   GetWord,
  11.   Exist,
  12.   DOS;
  13.  
  14. Const
  15.    Version = '1.0';
  16.  
  17. var
  18.   OutFile,
  19.   PageFile : Text;
  20.   OutFileName,
  21.   PageFileName : String;
  22.  
  23.   PageLength : LongInt;
  24.  
  25.   ToneLn,
  26.   WaitLn  : integer;
  27.   ToneS   : integer;
  28.  
  29.   Tmp,
  30.   TmpS    : String;
  31.  
  32.   Buffer  : char;
  33.  
  34. Function StUpCase(st:string):string;  { converts string (St) to uppercase }
  35.   var x : byte;
  36.   Begin
  37.     StUpCase:='';  StUpCase[0]:=#0;
  38.     StUpCase[0]:=St[0];
  39.     for x:=1 to length(st) do StUpCase[x]:=UpCase(St[x]);
  40.   end;
  41.  
  42. Function Str2Int(st:string):integer;  { converts string (St) to integer }
  43.   var x, z : integer;
  44.   begin
  45.     Val(St,X,Z);
  46.     Str2Int:=x;
  47.   end;
  48.  
  49. Procedure OutError(Fn:string);
  50.   Begin
  51.     Writeln;  Writeln;
  52.     Writeln('Error:  Cannot create ',StUpCase(Fn),'!');
  53.     halt;
  54.   End;
  55.  
  56. Procedure ConvertIt (PlayFile : String);
  57. Begin
  58.   TmpS := '';
  59.   Write ('Scanning '+StUpCase(PlayFile)+' to '+StUpCase(OutFilename)+'...');
  60.   Assign (PageFile, PlayFile);
  61.   {$I-} Reset (PageFile); {$I+}
  62.   Assign (OutFile, OutFilename);
  63.   {$I-} Rewrite(OutFile); {$I+}
  64.   If IOResult <> 0 then outerror(outfilename);
  65.   Writeln(outfile,'{  Created using RATOTP version 1.0  }');
  66.   Writeln(outfile,'{  Copyright (C) 1990 RodentWare, all rights reserved.  }');
  67.   Writeln(outfile,'{  Michael Reece/James Calvert * 1:3801/42  }');
  68.   writeln(outfile);
  69.   Writeln(outfile,'Program SoundFile;');
  70.   Writeln(outfile);
  71.   Writeln(outfile,'Uses CRT;');
  72.   Writeln(outfile);
  73.   Writeln(outfile,'Begin');
  74.   Writeln(outfile,'  Writeln;');
  75.   Writeln(outfile,'  Writeln(''Playing SoundFile created using RATOTP v1.0!'');');
  76.   Writeln(outfile,'  Writeln(''Copyright (C) 1990 RodentWare, all rights reserved.'');');
  77.   Writeln(outfile,'  Writeln;');
  78.     while Not Eof (PageFile) Do
  79.     Begin
  80.       Readln (PageFile, TmpS);
  81.       If TmpS[1] = ';' then ;      { do nothing }
  82.       TmpS := StUpCase (TmpS);      { uppercase the string }
  83.       no_space(tmps);
  84.       Tmp := Get_Word(TmpS,1);
  85.       If Tmp = 'TONE' then
  86.         begin
  87.           ToneS := Str2Int (Get_Word(Tmps, 2));
  88.           ToneLn:= Str2Int (Get_Word(Tmps, 3));
  89.           ToneLn := ToneLn * 10;
  90.           PageLength:=PageLength+ToneLn;
  91.           Writeln(outfile,'  Sound (',ToneS,');');
  92.           Writeln(outfile,'  Delay (',ToneLn,');');
  93.           Writeln(outfile,'  NoSound;');
  94.         end;
  95.       If Tmp = 'WAIT' then
  96.         Begin
  97.           WaitLn := Str2Int (Get_Word(TmpS, 2));
  98.           WaitLn := WaitLn * 10;
  99.           PageLength:=PageLength+WaitLn;
  100.           Writeln(outfile,'  Delay (',WaitLn,');');
  101.         End;
  102.     End;
  103.     Writeln(outfile,'  Writeln(''Done!'');');
  104.     Writeln(outfile,'End.');
  105.     Writeln('Done!');
  106.     Writeln;
  107.     {$I-} Reset (PageFile); {$I+}
  108.   {$I-} Close (PageFile); {$I+}
  109.   {$I-} Close (outfile); {$I+}
  110. End;
  111.  
  112. Procedure Stop (FileName : String);
  113. Begin
  114.   Writeln ('Error: '+StUpCase(Filename)+' does not exist!');
  115.   halt;
  116. End;
  117.  
  118. Begin
  119.   Assign (Input,'');
  120.   Assign (Output,'');
  121.   Rewrite (Input);
  122.   Rewrite (Output);
  123.   Writeln;
  124.   Writeln ('RATOTP version 1.0');
  125.   Writeln ('RemoteAccess (pagefile) to TurboPascal (sourcecode)');
  126.   Writeln ('Copyright (C) 1990 RodentWare, All rights reserved.');
  127.   Writeln ('Michael Reece/James Calvert * 1:3801/42');
  128.   Writeln;
  129.   If ParamCount < 2 then
  130.    Begin
  131.      Writeln ('Usage: RATOTP <page filename> <destination file>');
  132.      Halt;
  133.    End;
  134.  
  135.    PageFileName := ParamStr(1);
  136.    OutFileName  := ParamStr(2);
  137.  
  138.    PageLength:=0;
  139.  
  140.    If FileExist (PageFileName) then
  141.      ConvertIt (PageFileName)
  142.    Else
  143.      Stop(PageFileName);
  144. end.
  145.  
  146.